home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / oo123.exe / OO123.PAS < prev   
Pascal/Delphi Source File  |  1993-03-16  |  28KB  |  831 lines
  1. Unit OO123;
  2.  
  3. (*
  4.    Over the last year we've lurked behind the scenes here, enjoying
  5.    the fruits of your labours.
  6.  
  7.    It seemed time to give something back, so here's a unit that will
  8.    enable you to create Lotus 1-2-3 V2.x compatible models quickly
  9.    and easily via OOP.  We use the TurboPower Object Professional 
  10.    date routines but any julian date routine will work if you change
  11.    TDateCell.Init.  If you don't have any date routines, just UNDEF
  12.    USEDATES.
  13.  
  14.    Here's a simple test program:-
  15.  
  16.    Program Test;
  17.  
  18.    {$N+,E+}
  19.  
  20.    Uses Objects, OO123;
  21.  
  22.    Var   P123 : PModel;
  23.          PD   : PDateCell;
  24.          PT   : PTextCell;
  25.          PN   : PNumericCell;
  26.          Y    : Word;
  27.    Begin
  28.       P123:=New(PModel, Init('TEST.WK1'));
  29.       If P123<>NIL then with P123^ do
  30.       Begin
  31.          PT:=AddTextCell('..Date..');
  32.          AddTextCell('Refce')^.JustRight;
  33.          AddTextCell('Amount')^.JustRight;
  34.          AddTextCell('Narration');
  35.          NewRow;
  36.          NewRow;
  37.          For Y:=1 to 100 do
  38.          Begin
  39.             PD:=AddDateCell('1/03/93');
  40.             PN:=AddNumericCell(Y);
  41.             PN:=AddNumericCell(100.00);
  42.             PT:=AddTextCell('This is a narration');
  43.             PT:=AddTextCell('');
  44.             If PT^.Value<>NIL then DisposeStr(PT^.Value);
  45.             PT^.Value:=NewStr('This is cell '+PT^.Reference);
  46.             NewRow;
  47.          end;
  48.          SetColumnWidth(3,30);
  49.          SetColumnWidth(4,30);
  50.          Save;
  51.          Dispose(P123, Done);
  52.       end;
  53.    end.
  54.  
  55.    PS: If you're wondering why there isn't a type TExpressionCell it's
  56.    because I've never figured out expression encoding.  There's a simple
  57.    workaround: just prefix each expression with a special character
  58.    (say '|'), then run the following Lotus 1-2-3 macro:-
  59.  
  60.    ------------------------------------------------------------------------
  61.  
  62.    \A       {indicate Formula Conversion..}{paneloff}{windowsoff}
  63.             /rncHERE~{bs}~
  64.             {home}
  65.             /rncWORKAREA~{bs}.{end}{home}~
  66.             {for WIDTH,1,@cols(WORKAREA),1,LOOP1}
  67.             {goto}HERE~
  68.             /rndWORKAREA~/rndHERE~
  69.             {indicate}
  70.  
  71.    LOOP1    {for HEIGHT,1,@rows(WORKAREA),1,LOOP2}
  72.             {right}{up HEIGHT-1}
  73.  
  74.    LOOP2    {if @cellpointer("type")<>"l"}{down}{return}
  75.             {if @length(@cellpointer("contents"))=0}/re~/rfr~{down}{return}
  76.             {if @left(@cellpointer("contents"),1)<>"|"}{down}{return}
  77.             {edit}{home}{del}{del}~
  78.             {down}
  79.  
  80.    WIDTH           8
  81.    HEIGHT         25
  82.  
  83.    ERRCHECK @code(@cellpointer)
  84.  
  85.    ------------------------------------------------------------------------
  86.  
  87.    If you know how to create a TExpressionCell the hard way, and you
  88.    wouldn't mind sharing your knowledge, then please feel free to e-mail
  89.    us.
  90.  
  91.    Enjoy...
  92.  
  93.    Steve Agnew
  94.    CIS 70032,2240
  95.  
  96. *)
  97.  
  98. {$D-,S-,R-,L-,N+,E+}
  99.  
  100. {$DEFINE USEDATES}
  101.  
  102. INTERFACE
  103.  
  104. Uses Objects, DOS 
  105.      {$IFDEF USEDATES} , OpDate {$ENDIF}
  106.      ;
  107.  
  108. CONST
  109.    fProtected  = $80;
  110.    fFixed      = $00;
  111.    fScientific = $10;
  112.    fCurrency   = $20;
  113.    fPercent    = $30;
  114.    fComma      = $40;
  115.    fSpecial    = $70;
  116.    fGeneral    = $01;
  117.    fDMY        = $02;
  118.    fDM         = $03;
  119.    fMY         = $04;
  120.    fText       = $05;
  121.  
  122. TYPE
  123.    PCell  = ^TCell;
  124.    TCell  = Object(TObject)
  125.                CellType   : Word;
  126.                CellLength : Word;
  127.                CellFormat : Byte;
  128.                CellColumn : Word;
  129.                CellRow    : Word;
  130.                Constructor Init(AType, AColumn, ARow : Word);
  131.                Procedure   SetFormat(AFormat : Byte);
  132.                Procedure   Write(Var S : TBufStream); VIRTUAL;
  133.                Function    Reference: String;
  134.             end;
  135.  
  136.    { -------------------------------------------------------------------- }
  137.  
  138.    PNumericCell  = ^TNumericCell;
  139.    TNumericCell  = Object(TCell)
  140.                       Value : Double;
  141.                       Constructor Init(AColumn, ARow : Word; AValue : Double);
  142.                       Procedure   Write(Var S : TBufStream); VIRTUAL;
  143.                    end;
  144.  
  145.    { -------------------------------------------------------------------- }
  146.  
  147.    PCurrencyCell  = ^TCurrencyCell;
  148.    TCurrencyCell  = Object(TCell)
  149.                       Value : Double;
  150.                       Constructor Init(AColumn, ARow : Word; AValue : Double);
  151.                       Procedure   Write(Var S : TBufStream); VIRTUAL;
  152.                    end;
  153.  
  154. {$IFDEF USEDATES}
  155.    { -------------------------------------------------------------------- }
  156.    PDateCell     = ^TDateCell;
  157.    TDateCell     = Object(TCell)
  158.                       Value : Double;
  159.                       Constructor Init(AColumn, ARow : Word; AValue : String);
  160.                       Procedure   Write(Var S : TBufStream); VIRTUAL;
  161.                    end;
  162. {$ENDIF}
  163.    { -------------------------------------------------------------------- }
  164.  
  165.    PTextCell  = ^TTextCell;
  166.    TTextCell  = Object(TCell)
  167.                       Just  : Char;
  168.                       Value : PString;
  169.                       Constructor Init(AColumn, ARow : Word; AValue : String);
  170.                       Procedure   Write(Var S : TBufStream); VIRTUAL;
  171.                       Procedure   JustLeft;
  172.                       Procedure   JustCentre;
  173.                       Procedure   JustRight;
  174.                       Destructor  Done; VIRTUAL;
  175.                    end;
  176.  
  177.    { -------------------------------------------------------------------- }
  178.  
  179.    PCellCollection = ^TCellCollection;
  180.    TCellCollection = Object(TSortedCollection)
  181.                        function  Compare(Key1, Key2: Pointer): Integer; VIRTUAL;
  182.                        function  FindCell(Col, Row : Word): Pointer;
  183.                        Procedure Write(Var S: TBufStream); VIRTUAL;
  184.                      end;
  185.  
  186.    { -------------------------------------------------------------------- }
  187.  
  188.    ColumnInfo = Record
  189.                    First    : Word;
  190.                    Last     : Word;
  191.                    Width    : Byte;
  192.                 end;
  193.  
  194.    PModel = ^TModel;
  195.    TModel = Object(TObject)
  196.                FileName : PathStr;
  197.                Cells    : PCellCollection;
  198.             PRIVATE
  199.                MaxRows  : Word;
  200.                MaxCols  : Word;
  201.                Row      : Word;
  202.                Col      : Word;
  203.                ColHdr   : Array[0..255] of ColumnInfo;
  204.             PUBLIC
  205.                Constructor Init(AFileName : PathStr);
  206.                Procedure   Save;
  207.                Procedure   NewRow;
  208.                Procedure   NewColumn;
  209.                Function    AddNumericCell (AValue : Double): PNumericCell;
  210.                Function    AddCurrencyCell (AValue : Double): PCurrencyCell;
  211.                {$IFDEF USEDATES}
  212.                Function    AddDateCell    (AValue : String): PDateCell;
  213.                {$ENDIF}
  214.                Function    AddTextCell    (AValue : String): PTextCell;
  215.                Procedure   SetColumnWidth (Column,Width: Word);
  216.                Function    FindCell(AColumn, ARow : Word): Pointer;
  217.                Destructor  Done; VIRTUAL;
  218.             end;
  219.  
  220.    { -------------------------------------------------------------------- }
  221.  
  222.  
  223. IMPLEMENTATION
  224.  
  225. Function NumToStr(N: LongInt): String;
  226. Var S : String;
  227. Begin
  228.    Str(N,S);
  229.    NumToStr:=S;
  230. end;
  231.  
  232. {  =============================[ TCELL ]============================ }
  233.  
  234. Constructor TCell.Init(AType, AColumn, ARow : Word);
  235.  
  236. Begin
  237.    If not Inherited Init then FAIL;
  238.    CellType    := AType;
  239.    CellColumn  := AColumn;
  240.    CellRow     := ARow;
  241.    CellFormat  := $71;
  242. end;
  243.    
  244. { -------------------------------------------------------------------- }
  245.  
  246. Procedure TCell.SetFormat(AFormat : Byte);
  247. Begin
  248.    CellFormat  := AFormat;
  249. end;   
  250.  
  251. { -------------------------------------------------------------------- }
  252.  
  253. Procedure TCell.Write(Var S : TBufStream);
  254. Begin
  255.    Abstract;
  256. end;
  257.  
  258. { -------------------------------------------------------------------- }
  259.  
  260. Function TCell.Reference: String;
  261.  
  262.